package Flap;
use Flap::Core qw/-b Flap::Object -m -r -s -w/;
our $VERSION = '0.0001';
our($BEGIN, %G, $MAIL_SPOOL_DIR, $NOW, %OBJECT);

sub import { shift->Core->_import(scalar caller, @_) }

sub app {
    my($proj, $app) = @_;
    $proj->_global_->{app}{$app} ||= do{
        my $lib = $proj->project_root."/apps/$app/lib";
        unshift @::INC, $lib if (!grep{ $_ eq $lib } @::INC) && -d $lib;
        require "$proj/$app.pm" && $proj.'::'.$app;
    };
}

sub begin {
    my $proj = shift;
    if($BEGIN){
        warn "$proj->begin called again";
        $proj->end;
    }
    my $opt = $BEGIN->{OPT} = {dbh_auto_reconnect => 0, trace => {}, %{shift || {}}};
    foreach(qw/__WARN__ __DIE__/){
        $BEGIN->{SIG}{$_} = $::SIG{$_} || '';
        $::SIG{$_} = $proj->tracer($_, $opt->{trace});
    }
    $proj;
}

sub config {
    my $proj = shift;
    $proj->_global_->{config}{$proj->env} ||= $proj->Config->load($proj->env);
}

sub dbh {
    my($proj, $db) = (shift, shift || 'Default');
    return $BEGIN->{DBH}{"$proj.$db"} ||= do{
        my $dbh = $proj->DBI->dbh($proj, $db);
        $dbh->auto_reconnect(1) if $BEGIN->{OPT}{dbh_auto_reconnect};
        $dbh;
    } if $BEGIN && !@_;
    $proj->DBI->dbh($proj, $db, shift || 0);
}

sub end {
    my $proj = shift;
    if($BEGIN){
        $_->finalize for values %{$proj->_global_->{dbh_pool}};
        $proj->found_mem_leak if %OBJECT;
        undef %OBJECT;
        $::SIG{$_} = $BEGIN->{SIG}{$_} for qw/__WARN__ __DIE__/;
        $BEGIN = undef;
    }else{
        require Carp;
        Carp::carp "$proj->begin not called";
    }
}

sub env { $::ENV{FLAP_ENV} || $::ENV{HARNESS_ACTIVE} ? 'test' : 'development' }

sub found_mem_leak {
    my @o = sort keys %OBJECT;
    @o = (@o[0 .. 2], '...') if @o > 3;
    warn 'Found mem leak('.join(', ', @o).')';
}

sub hostname { $Flap::G{hostname} ||= do{ require Sys::Hostname; &Sys::Hostname::hostname() } }

sub log {
    my $proj = shift;
    $proj->_global_->{logger}{$_[0] || 'default'} ||= $proj->Logger->new(@_);
}

sub now { shift->Time->now(@_) }

sub root_dir {
    my $pm = "$_[0].pm";
    $::INC{$pm} =~ m%^(.+)/lib/\Q$pm\E\z% ? $1 : die qq{Can't detect root for "$::INC{$pm}"};
}

sub schema {
    my $db = $_[1] || return shift->Schema->Default;
    shift->Schema->$db;
}

sub today { shift->Date->today(@_) }

sub tracer {
    my($proj, $sig, $opt) = @_;
    my $die = $sig eq '__DIE__';
    
    sub{
        local $::SIG{$sig} = $BEGIN->{SIG}{$sig};
        my($i, @t);
        while(my($pkg, $path, $line, $sub) = caller($i++)){
            push @t, [$path, $line, $i == 1 ? $sig : $sub];
            last if $die && $sub eq '(eval)';
        }
        
        (my $msg = $_[0]) =~ s/ at \Q$t[0]->[0]\E line \Q$t[0]->[1]\E\.\n\z/\n/;
        while(my $t = shift @t){
            next if(@t && $opt->{exclude} && $t->[2] =~ $opt->{exclude});
            $t->[0] =~ s%^\Q$_/\E%% && last for @::INC;
            $msg .= " at $t->[2]($t->[0] $t->[1])\n";
        }
        $i->INTERPOLATE_TRACE($sig, \$msg) if ($i = $opt->{interpolator});
        if($die){
            $opt->{die} ? $opt->{die}->($msg) : die $msg;
        }else{
            $opt->{warn} ? $opt->{warn}->($msg) : warn $msg;
        }
    };
}

sub trace_option { $BEGIN && $BEGIN->{OPT}{trace} }

1;
__END__

=head1 NAME

Flap - Fast/Lightweight Application Platform

=head1 COPYRIGHT

Copyright 2011- Kazutaka Ueda

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
